home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / brklyprl.lha / Emulator / control.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-04-14  |  4.8 KB  |  234 lines
  1.  
  2. /* Copyright (C) 1988, 1989 Herve' Touati, Aquarius Project, UC Berkeley */
  3.  
  4. /* Copyright Herve' Touati, Aquarius Project, UC Berkeley */
  5.  
  6. #include <stream.h>
  7. #include "tags.h"
  8. #include "instr.h"
  9. #include "hash_table.h"
  10. #include "string_table.h"
  11. #include "scan.h"
  12. #include "inst_args.h"
  13. #include "memory.h"
  14. #include "basics.h"
  15. #include "top_level.h"
  16. #ifdef WITH_GC
  17. #include "gc.h"
  18. #endif
  19.  
  20. #define max(a,b) (((a) > (b)) ? (a) : (b))
  21.  
  22.  /* conventions: */
  23.  /* a HEAP POINTER is stored by casting it to UNSIGNED */
  24.  /* a STACK POINTER register is stored by casting it to UNSIGNED */
  25.  /* a CODE POINTER is stored by casting it to UNSIGNED */
  26.  
  27. void Init() 
  28. {
  29.   Cell* var = &E[P->arg1];
  30.   *var = make_cell(TAGREF, var);
  31. }
  32.  
  33. void init_control_registers()
  34. {
  35.   P = P0;
  36.   H = H0;
  37.   R = R0;
  38.   TR = TR0;
  39.   B = B0;
  40.   E = E0;
  41.   for (int i = 0; i < NUMBER_OF_REGISTERS; i++)
  42.     X[i] = 0;
  43.  
  44. #ifdef WITH_GC
  45.  
  46.  /* move the trail stack down for new space and the marking area */
  47.   int size = window_size + window_size /4 + 1;
  48.   if ((TR0 - H0) < 2 * size) 
  49.     top_level_error("Too large a window size\n");
  50.   if (window_size/2 < HMAX_SECURITY)
  51.     top_level_error("Too small a window size\n");
  52.   HMAXHARD = E0;
  53.   HMAXSOFT = HMAXHARD - HMAX_SECURITY;
  54.   HMIN = HMAXHARD - window_size;
  55.   TR = TR0 = HMIN - window_size /4 - 2;
  56.   B0[TR_CP_OFFSET] = cell(TR0);
  57.   B0[H_CP_OFFSET] = cell(HMIN);
  58.   MKMIN = (char*) (TR0 + 1);
  59.  
  60.  /* put H in new space and initialize the 2's pointers */
  61.   H = HMIN;
  62.   H2 = H0;
  63.   E2 = E0;
  64.   TR2 = TR0;
  65.  
  66.   GC_COUNTER = 0;
  67.   gc_scanned = 0;
  68.   gc_copy_scanned = 0;
  69.   gc_survivors = 0;
  70.   tr_scanned = 0;
  71.   tr_survivors = 0;
  72.   gc_time = 0;
  73. #endif
  74. }
  75.  
  76.  /* compute the top of the env stack */
  77.  /* allocate the first part of an environment: B + E */
  78.  /* and do a BALR (branch and link: see the IBM 360) */
  79.  
  80. void Call() 
  81. {
  82.   Cell* top_for_E = E + P->arg2;
  83.   Cell* top_for_B = cellp(B[E_CP_OFFSET]);
  84.   Cell* NewE = max(top_for_E, top_for_B) + E_TOP_OFFSET;
  85.   NewE[B_ENV_OFFSET] = cell(B);
  86.   NewE[E_ENV_OFFSET] = cell(E);
  87.   NewE[P_ENV_OFFSET] = cell(P);
  88.   E = NewE;
  89.  
  90. #ifdef WITH_GC
  91.   if (H >= HMAXSOFT)
  92.     garbage_collector();
  93. #else
  94.   if (H > TR)
  95.     top_level_error("Heap Overflow");
  96. #endif
  97.  
  98.   P = instrp(P->arg1);
  99. }
  100.  
  101.  /* The original value of CP points to an instruction */
  102.  /* that just report success */
  103.  /* this instruction could be any instruction, for example the last one */
  104.  /* it is even possible to make the compiler generate it for us */
  105.  /* the problem with that is that it will generate it for every procedure */
  106. void Proceed() 
  107. {
  108.   P = instrp(E[P_ENV_OFFSET]);
  109.   E = cellp(E[E_ENV_OFFSET]);
  110. #ifdef WITH_GC
  111.   if (E < E2)
  112.     E2 = E;
  113. #endif
  114. }
  115.   
  116. void ExecuteProc() 
  117. {
  118.   if (cellp(B[E_CP_OFFSET]) >= E) {
  119.     Cell* NewE = cellp(B[E_CP_OFFSET]) + E_TOP_OFFSET;
  120.     NewE[B_ENV_OFFSET] = cell(B);
  121.     NewE[E_ENV_OFFSET] = E[E_ENV_OFFSET];
  122.     NewE[P_ENV_OFFSET] = E[P_ENV_OFFSET];
  123.     E = NewE;
  124.   }
  125.  
  126. #ifdef WITH_GC
  127.   if (H >= HMAXSOFT)
  128.     garbage_collector();
  129. #else
  130.   if (H > TR)
  131.     top_level_error("Heap Overflow");
  132. #endif
  133.  
  134.   P = instrp(P->arg1);
  135. }
  136.  
  137. void ExecuteLabel() {
  138.   P = instrp(P->arg1);
  139. }
  140.  
  141. void Cut() {
  142.   B = cellp(E[B_ENV_OFFSET]);
  143. }
  144.   
  145. void Escape() {
  146.   (*procp(P->arg1))();
  147. }
  148.  
  149. void Try() 
  150. {
  151.   int number_of_registers = P->arg2;
  152.   B -= FIXED_CP_SIZE + number_of_registers;
  153.   B[E_CP_OFFSET] = cell(E);
  154.   B[H_CP_OFFSET] = cell(H);
  155.   B[TR_CP_OFFSET] = cell(TR);
  156.   B[P_CP_OFFSET] = cell(P);
  157.   B[SIZE_CP_OFFSET] = number_of_registers;
  158.   for (int i = 0; i < number_of_registers; i++)
  159.     B[X1_CP_OFFSET + i] = X[i];
  160.   P = instrp(P->arg1);
  161. }
  162.  
  163. void Retry() {
  164.   B[P_CP_OFFSET] = cell(P);
  165.   P = instrp(P->arg1);
  166. }
  167.  
  168. void Trust() {
  169.   B = cellp(E[B_ENV_OFFSET]);
  170.   P = instrp(P->arg1);
  171. }
  172.  
  173. void TryMeElse() 
  174. {
  175.   int number_of_registers = P->arg2;
  176.   B -= FIXED_CP_SIZE + number_of_registers;
  177.   B[E_CP_OFFSET] = cell(E);
  178.   B[H_CP_OFFSET] = cell(H);
  179.   B[TR_CP_OFFSET] = cell(TR);
  180.   B[P_CP_OFFSET] = P->arg1;
  181.   B[SIZE_CP_OFFSET] = number_of_registers;
  182.   for (int i = 0; i < number_of_registers; i++)
  183.     B[X1_CP_OFFSET + i] = X[i];
  184. }  
  185.  
  186. void RetryMeElse() {
  187.   B[P_CP_OFFSET] = P->arg1;
  188. }
  189.  
  190. void TrustMeElse() {
  191.   B = cellp(E[B_ENV_OFFSET]);
  192. }
  193.  
  194. void SwitchOnTerm()
  195. {
  196.   Cell X0 = deref(X[0]);
  197.   switch(get_tag(X0)) {
  198.   case TAGCONST:
  199.     P = instrp(P->arg1);
  200.     break;
  201.   case TAGLIST:
  202.     P = instrp(P->arg2);
  203.     break;
  204.   case TAGSTRUCT:
  205.     P = instrp(P->arg3);
  206.     break;
  207.   case TAGREF:
  208.     break;
  209.   }
  210. }
  211.  
  212. HashTable* table_of_tables;
  213. void init_run_time_tables()
  214. {
  215.   table_of_tables = instr_args[ARG_TABLE]->TableOfTables;
  216. }
  217.  
  218. void SwitchOnConstant()
  219. {
  220.   HashTable* table = (HashTable*) table_of_tables->get(P->arg1);
  221.   P = instrp(table->get(deref(X[0])));
  222.   if (table->status == HASH_MISS)
  223.     P = FP0;
  224. }
  225.  
  226. void SwitchOnStructure()
  227. {
  228.   HashTable* table = (HashTable*) table_of_tables->get(P->arg1);
  229.   P = instrp(table->get(*addr(deref(X[0]))));
  230.   if (table->status == HASH_MISS)
  231.     P = FP0;
  232. }
  233.  
  234.